--# -path=.:prelude:alltenses
concrete SyllogismFre of Syllogism = LexiconSyllFre **
   open CommonRomance , StructuralFre, IrregFre,
    StringOper, ResFre, DiffFre, Prelude in {
  flags coding=utf8 ;

  param WClass = IsNoun | IsVerb | IsAdj | IsPhrase;
  param PClass = Single | SConjunct | SDisjunct;  

-- Masc, Fem
 
 lincat Syllogism = {s : Str};
        Sentence  = {s : Str};
        Subject   = {s : Number => Str; g : Gender};
        Property  = {s : Number => Polarity => Gender => Str;
                     c : PClass};
        PropertyPart = {s : Either => Number => Polarity => Gender =>  Str;
                           c : WClass; lock_PropertyPart : {} }; 
        Word = {sub : Number => Str;
                prop : Either => Number => Polarity => Gender => Str;
                g: Gender;c : WClass  };
--Conjunct
-- får man säga fast konstanter i stora lexiconet inte har gender?

        Constant   = {s : Str; g : Gender};
        Sentence   = {s : Str};
        Sentences  = {s : Str};
        Const = {s : Str; g : Gender};
        AllQ  = {s : Gender => Str}; -- ; n : Number}; 
        NoQ   = {s : Gender => Str}; --n : Number};

 lin
   AWord a = {sub = (adjToSub a).s;  prop = (adjToProp a).s; g = Masc;
              c = IsAdj};
   NWord n = {sub = (nounToSub n).s; prop = (nounToProp n).s; g = n.g;
              c = IsNoun};
   VWord v ={sub = (verbToSub v).s;  prop = (verbToProp v).s; g = Masc;
             c = IsVerb};
   CWord c = c; 

   CpP const prop = {s = const.s ++ prop.s ! Sg ! Pos ! const.g};
   CnP const prop = {s = const.s ++ prop.s ! Sg ! Neg ! const.g};
   SaP allq sub prop = {s = allq.s ! sub.g ++ sub.s ! Pl ++
                             prop.s ! Pl ! Pos !  sub.g};
   SoP sub prop = {s = some_Det sub.g ++ sub.s ! Pl ++ prop.s ! Pl ! Neg ! sub.g};
   SeP noq sub prop = let quant = sepq sub prop noq in
                  {s = quant.s ++ sub.s ! quant.n 
                                 ++ prop.s ! quant.n ! quant.p ! sub.g};
   SiP sub prop = {s = some_Det sub.g ++ sub.s ! Pl ++ prop.s ! Pl ! Pos ! sub.g};

   ToProperty sWord = mkProp sWord ** {c = Single};  
   ToSubject  sWord = {s = sWord.sub; g = sWord.g};
   ToConstant cWord = cWord;
   ToPropertyPart word = {s = word.prop; c = word.c} 
                                  ** {lock_PropertyPart = <>};  

   SPhrase a n = {s = (phrToSub a n).s; g = n.g};
   PPhrase a n = {s = (phrToProp a n).s; c = Single};  

   All = {s = table {Masc => "tous les"; Fem => "toutes les"}; n = Pl}; 
   No = {s = table {Masc =>"aucun"; Fem => "aucune"}; n = Sg};


   mkSyllogism ps c = {s = "(" ++ ps.s ++ ") ->" ++ c.s };

   mkSentences  s1 s2 = {s = s1.s ++ "+" ++ s2.s};
   appSentences s1 ss = {s = s1.s ++ "+" ++ ss.s};
   And p1 p2 = {s = \\num,pol,gen => propAnd p1 p2 num pol gen;
                c = SConjunct} ; 
   Or  p1 p2 = {s = \\num,pol,gen => propOr p1 p2 num pol gen;
                c = SDisjunct};  
 
-- V = Verb ;
-- Verb = {s : VF => Str ; vtyp : VType} ;
-- N = Noun ;       
-- Noun : {s : Number => Str ; g : Gender}
-- A  = {s : Degree => AForm => Str ; isPre : Bool} 


--------OPERATIONS--------------------------------------------------

 {-
   The parameter Either works like a placeholder in a property which tells
   where to insert either/neither/both/not.
   NorS is for the second part of a dis/onjunction and gives the phrase 
   whithout "is" or "does" (eg. "a laptop").
   NoneS is for phrases without any of these words. 
 -}
 param Either  = NotS | NeitherS | EitherS | NorS | NoneS | BothS;
  
 oper
  notStr : Either -> Str =
   \not -> case not of {
     NotS => "ne pas"; -- ne .. pas
     NeitherS => "ne ni"; -- 
     EitherS => "ou ou";
     NorS    => "ni";
     BothS   => "aussi bien que";
     NoneS   => ""}; -- ?  
   


  -- creates a Property from a PropertyPart
  mkProp : PropertyPart -> {s : Number => Polarity => Gender => Str} =
    \w ->
     {s = \\n => table {Neg => \\g => w.s ! NotS ! n ! Neg ! g;
                        _   => \\g => w.s ! NoneS ! n ! Pos ! g}};

-- A  = {s : Degree => AForm => Str ; isPre : Bool} 

-- given an adjective, gender and number return the corresponding adjetive
  adjSgPl : A -> Gender -> Number -> Str = \wor, g, n ->
     case n of {
       Sg => wor.s ! Posit ! (AF g n) ; --AF (APosit (Strong (GSg g))) Nom; 
       Pl => wor.s ! Posit ! (AF g n) --AF (APosit (Strong (GPl g))) Nom
     };

--AForm (AF Gender Number)
--{ s : AF => String

  -- given an adjective, returns it in plural form
--  adjPl : A -> Gender -> Str = \wor, g ->
--     wor.s ! AF (APosit (Strong (GPl g))) Nom; 

  -- given an adjective and a Gender, returns the adjective in singular form
 -- adjSg : A -> Gender -> Str = \wor, g ->
  --  wor.s ! (AF (APosit (Strong (GSg g))) Nom);


  -- given a verb, returns the VForm that should be used
{-
  getVerbForm : VType -> VF =
    \type ->
    case type of {
      VPass => VF (VPres Pass);
      _     => VF (VPres Act)
    };
-}

  etreSyl : Number -> Str =
    \num -> case num of
       {Sg => "est";
        Pl => "sont"};

  -- operations for creating Words out of adjectives, nouns and verbs
  adjToProp : A -> {s : Either => Number => Polarity => Gender => Str}
     =  \wor -> 
       { s  = table {NorS => table {Sg => \\_,g => adjSgPl wor g Sg ; 
                                    Pl => \\_,g => adjSgPl wor g Pl };
                     not  => table{
                 Sg => \\_,g => etreSyl Sg ++ notStr not ++ adjSgPl wor g Sg; 
                 Pl => \\_,g => etreSyl Pl ++ notStr not ++ adjSgPl wor g Pl 
                      }
        }} ;   

  adjToSub : A -> {s : Number => Str} = \adj -> 
         { s = \\n => "qui" ++ etreSyl n ++ adjSgPl adj Masc n}; 

--table{Sg => "qui" ++ etreSyl Sg ++ adjSg adj Masc; 
  --                   Pl => "qui" ++ etreSyl Pl ++ adjPl adj Masc}};

  nounToSub : N -> {s : Number => Str } = \wor -> 
     { s = table {Sg => wor.s ! Sg ; 
                  Pl => wor.s ! Pl } 
     }; 

  nounToProp : N -> { s : Either => Number => Polarity => Gender => Str }
       = \wor -> 
     { s = table{
         NorS => table{
           Sg => \\_,_ => artIndef wor.g Sg Nom ++ wor.s ! Sg ;
           Pl => \\_,_ => artIndef wor.g Sg Nom ++ wor.s ! Pl };
         not => table {
           Sg => \\_,_ => etreSyl Sg ++ notStr not 
                         ++ artIndef wor.g Sg Nom  ++ wor.s ! Sg   ; 
           Pl => \\_,_ => etreSyl Pl ++ notStr not ++ artIndef wor.g Sg Nom ++ wor.s ! Pl
                 }      
     }} ;        

{- Mood   = Indic | Conjunct ;
param 
  VF =
     VInfin Bool
   | VFin   TMood Number Person 
   | VImper NumPersI 
   | VPart  Gender Number 
   | VGer
   ;

  TMood = 
     VPres  Mood

        Mood   = Indic | Conjunct ;


-}

  verbToSub :  V -> {s: Number => Str}
      = \wor -> -- let vform = VInfin True in --getVerbForm wor.vtyp
   { s = table {Sg => "qui" ++ wor.s ! VFin (VPres Indic) Sg P3;  
                Pl => "qui" ++ wor.s ! VFin (VPres Indic) Pl P3} }; 

  verbToProp : V -> { s : Either => Number => Polarity => Gender => Str} 
     = \wor -> -- let vform = VInfin True in   
  { s = table{
   NorS => \\n,_,g => wor.s ! VFin (VPres Indic) n P3;
   NotS => \\n => table {Neg => \\g => wor.s ! VFin (VPres Indic) n P3 ++ "inte"; 
                         _   => \\g => wor.s ! VFin (VPres Indic) n P3 };
   either => \\n,_,g => notStr either ++ wor.s ! VFin (VPres Indic) n P3}};



  -- operations for creating Words out of phrases like 'en blå blomma'
  phrToSub : A -> N -> {s : Number => Str} =
     \a, n -> 
     {s = table {Sg => adjSgPl a n.g Sg ++ n.s ! Sg ;
                 Pl => adjSgPl a n.g Pl ++ n.s ! Pl }};
  
  phrToProp : A -> N -> {s : Number => Polarity=> Gender => Str} =
    \a, n ->
     {s = table {
         Sg => table{    
             Neg => \\_ =>  etreSyl Sg ++ notStr NotS ++ artIndef n.g Sg Nom ++ adjSgPl a n.g Sg
                                              ++ n.s ! Sg ;
             _    => \\_ => etreSyl Sg ++ artIndef n.g Sg Nom ++ adjSgPl a n.g Sg 
                                        ++ n.s ! Sg }; 
         Pl => table{
             Neg=> \\_ => etreSyl Pl ++ notStr NotS ++ adjSgPl a n.g Pl
                                                  ++ n.s ! Pl ;
             _   => \\_ => etreSyl Pl ++ adjSgPl a n.g Pl ++ n.s ! Pl }}};

  -- operations for conjuctions 
  propAnd : PropertyPart -> PropertyPart -> Number -> Polarity 
                                                         -> Gender -> Str =
    \word1, word2, num, pol, gen ->
      let begin = (word1.s ! polarityW1 pol ! num ! pol ! gen ++ "et") in
         case sameClass word1.c word2.c of {
           True  => begin ++ word2.s ! polarityW2 pol True ! num ! pol ! gen ;
           False => begin ++ word2.s ! polarityW2 pol False ! num ! pol ! gen
         };

  polarityW1 : Polarity -> Either = 
     \pol -> case pol of{
          Neg => NotS;
          _    => BothS};

  polarityW2 : Polarity -> Bool -> Either = 
     \pol, b -> case pol of{
          Neg => NotS;
          _    => case b of { True =>  NorS; False => NoneS}};

  -- operations for disjuction 
  propOr : PropertyPart -> PropertyPart -> Number -> 
                  Polarity -> Gender -> Str
      = \word1, word2, num, pol, gen ->
     case pol of {
         Pos => combineDisj word1 word2 num Pos gen EitherS;
         _    => combineDisj word1 word2 num Pos gen NeitherS 
      };
 

  combineDisj : PropertyPart -> PropertyPart -> Number ->
          Polarity -> Gender -> Either -> Str
   = \word1, word2, num, pol, gen, not -> 
     let begin = word1.s ! not ! num ! pol ! gen ++ "eller"  in
    case sameClass word1.c word2.c of{
      True => begin ++ word2.s ! NorS ! num ! pol ! gen;
      False => begin ++ word2.s ! NoneS ! num ! pol ! gen
  }; 

-- for seeing how two words can be combined
  sameClass : WClass -> WClass -> Bool =
   \c1, c2 -> case c1 of{
     IsVerb => case c2 of{ IsVerb => True;
                           _       => False};
      _     => case c2 of{ IsVerb => False;
                            _      => True}};



   some_Det : Gender -> Str =
     \g -> case g of
       {Masc => "certains";
        Fem  => "certaines"};  

   sepq : Subject -> Property -> NoQ -> {s : Str; n : Number; p : Polarity} =
     
 \sub,p,no -> case p.c of 
          {SDisjunct => case sub.g of
                 {Masc => {s = "tous les"; n = Pl; p = Neg};
                  Fem  => {s = "toutes les"; n = Pl; p = Neg}};
           _         => {s = no.s ! sub.g ;  n = Sg; p = Pos}};

}

